unit GameObjects;

interface
uses sdl, VectorGeometry, ScriptEngineI, lists, WorldI, SoundSystemI;

//the game object's flags
const
{**determines automatic destroying of an object when releasing world. might be usefull for special objects e.g.
game controller, which must live for all time, to manage level loading etc.}
GF_Unmanaged=1;
GF_Solid = 2;
GF_HasSoundGeometry= 4;
GF_ListenerAttached=8;
GF_AffectGravity = 16;

{**Basic Game Object Class in hierarchy. It can process events and have input action map.}
type TBasicObject=class
private
//**Reference to the object representing this in scripts
ScriptRef:TScriptReference;
//**Actions mapped to physical input (e.g. specific keys on keyboard)
InputActionMap:PList;
//**list of the object's registered timers
FTimers:PList;
//**object's specific flags
FFlags:cardinal;
public
{**This method will be called by the world manager each time object receives an event. it will be passed to the
object in script, assigned to this one}
procedure ProcessEvent(event:tsdl_event); virtual;
{**Adds a relationship between some physical input event and action for the object.
 @param(sym character representation of input (may be single key or key combination))
 @param(action code of the action)
 @param(data reference to the data passed from the script)
 }
Procedure AddInputAction(sym:string; action:integer; data:TScriptReference);
//**Removes all input/action bindings from the object
Procedure ClearInputActions;
{**Removes specific binding from the object action map
 @param(action code of the action to remove)}
  Procedure RemoveInputAction(action:integer);
//**registers an object's action map in the input system
Procedure RegisterInputActions;
//**removes an object's action map from input system
Procedure UnregisterInputActions;
Function AddTimer(interval:integer; continuous:boolean; data:TScriptReference):pointer;
procedure RemoveTimer(timer:pointer);
procedure SetFlags(f:cardinal);
{**Creates a new Game Object.
@param (ScriptRef Reference to the object representing this in the script)
@param(flags object's specific flags)}
constructor create(ScriptRef:TScriptReference; flags:cardinal=0);
//**Read-only property to get reference on the object, representing this in the script
property ScriptReference:TScriptReference read ScriptRef;
property flags:cardinal read FFlags write SetFlags;
end;

{**This is basic class for all objects, who have its real representation in world (position, size, rotation)
and can collide with other such objects. also an object might have list of attached sounds, which it will manage.}
TGenericObject=class(TBasicObject)
                                        private
FPosition:TVector3f;
FGeometry:TGeometricalPrimitive;
FSoundGeometry:ss_geometry;
FSounds:PList;
Procedure SetPosition(pos:TVector3F);
//**Checks a collision on the new position
function ProcessNewPos:boolean;
//**passes the collision event to the script
                                     procedure ProcessCollision(victim:TGenericObject);
//**calculates min and max vertices (if box) and rotates Sound Geometry and attached sounds if any.
procedure moveSounds(const v:TVector3F);
                                     procedure ProcessRotation;
Procedure SetSoundsVelocity(v:TVector3F);
  public
  //**used to prevent repeating collisions when one object moves inside other
FLastCollided:TGenericObject;
  {**moves object by adding v to its position, it also checks collisions on the way object will move.
@param(IgnoreSolid object will be moved if even there are obstacles on its way.)
@returns (@true if there are no solid objects during the moving way (when IgnoreSolid is set to @true function allways returns @true), which bounds this one. @false othervise)}
  function Move(v:TVector3F; IgnoreSolid:boolean=false):boolean;
//**turns object around X axis
//**@param (angle angle on which to turn)
procedure Pitch(angle:single);
  //**turns object around Y axis
  //**@param (angle angle on which to turn)
  procedure Yaw(angle:single);
//**turns object around Z axis
                                         //**@param (angle angle on which to turn)
  Procedure Roll(angle:single);
function GetObjectUnderThis:TGenericObject;
  //**adds sound to the object's managed sound list
  Procedure AttachSoundHandle(handle:SoundHandle);
  //**removes sound from the object's managed sound list
  Procedure DetachSoundHandle(Handle:SoundHandle);
Function Play3DSound(const res:PChar; pos:TVector3F; HeadRelative:boolean=false):SoundHandle;
Function Play3DSoundOnce(const handle:SoundHandle; res:PChar; pos:TVector3F; headrelative:boolean=false):SoundHandle;
procedure SetListener(pos:TVector3F);
  constructor create(ScriptRef:TScriptReference; flags:cardinal; const pos:TVector3F; const primitive:TGeometricalPrimitive; directocclusion:single=1; reverbocclusion:single=0);
property position:TVector3F read FPosition write SetPosition;
property Geometry:TGeometricalPrimitive read FGeometry;
                                        end;
                                        TDynamicObject=class(TGenericObject)
                                        private
                                        FVelocity:TVector3F;
FRelativeVelocity:TVector3F;
FAccel:TVector3F;
FRelativeAccel:TVector3F;
FFreeFalling:boolean;
Function CalculateVelocity:TVector3F;
procedure SetVelocity(v:TVector3F);
Procedure SetRelativeVelocity(v:TVector3F);
public
constructor create(ScriptRef:TScriptReference; flags:cardinal; const pos:TVector3F; const primitive:TGeometricalPrimitive; directocclusion:single=1; reverbocclusion:single=0);
procedure ProcessEvent(event:tsdl_event); override; 
procedure update(TimeElapsed:single);
property Velocity:TVector3F read FVelocity write SetVelocity;
property RelativeVelocity:TVector3F read FRelativeVelocity write SetRelativeVelocity;
property Accel:TVector3F read FAccel write FAccel;
Property RelativeAccel:TVector3F read FRelativeAccel write FRelativeAccel;
                                        end;
                                        procedure GameObj_RequireNeededPlugins;
var world:IWorld;
implementation
uses Common, coreI, LuaBindings, InputI, ObjectsHelper;
type PInputActionMapNode=^TInputActionMapNode;
//**Structure, in which object saves info about each binding of action and input events.
TInputActionMapNode = record
//**character representation of a physical key
sym:string;
//**assigned action code
action:integer;
//**reference to data, passed from script
data:TScriptReference;
end;
type PObjSoundListNode = ^TObjSoundListNode;
TObjSoundListNode = record
handle:SoundHandle;
pos:TVector3F;
end;
Type PObjTimerListNode=^TObjTimerListNode;
TObjTimerListNode=record
TimerID:TTimerID;
data:TScriptReference;
continuous:boolean;
obj:TBasicObject;
end;

var input:IInput;
SoundSystem:ISoundSystem;
SoundGeometry:ISoundGeometry;

function ObjTimerCallback(const timer:TTimerID; const data: Pointer): integer; cdecl;
begin
if World_GameObjectExists(PObjTimerListNode(data)^.obj) then
world_PushGameEvent(PObjTimerListNode(data)^.obj, WORLDEVENT_Timer, data);
if not PObjTimerListNode(data)^.continuous then result:=-1 else result:=0;
end;

{ TBasicObject }
procedure TBasicObject.AddInputAction(sym: string; action: integer;
  data: TScriptReference);
  var n:PInputActionMapNode;
  begin
                         new(n);
                         n^.sym := sym;
                         n^.action := action;
                         n^.data := data;
                         list_add(InputActionMap, n);
end;

function TBasicObject.AddTimer(interval: integer; continuous: boolean;
  data: TScriptReference): pointer;
var t:PObjTimerListNode;
begin
 new(t);
 t^.data := data;
 t^.continuous := continuous;
t^.obj := self;
t^.TimerID := Core_AddTimer(interval, ObjTimerCallback, t);
 list_add(FTimers, t);
result:=pointer(t^.TimerID);
 end;

procedure TBasicObject.ClearInputActions;
begin
    list_freeall(InputActionMap);
end;

constructor TBasicObject.create(ScriptRef:TScriptReference; flags:cardinal=0);
begin
self.ScriptRef := scriptref;
FFlags:=flags;
end;

procedure TBasicObject.ProcessEvent(event: tsdl_event);
begin
    case event.type_ of
EVENT_GAMEACTION:
if PGameEvent(event.user.data1)^.code = WORLDEVENT_TIMER then begin
ProcessTimerEvent(self,PObjTimerListNode(PGameEvent(Event.user.data1)^.data)^.data);
if not PObjTimerListNode(PGameEvent(Event.user.data1)^.data)^.continuous then
//list_remove(FTimers, PObjTimerListNode(PGameEvent(Event.user.data1)^.data), true);
RemoveTimer(pointer(PObjTimerListNode(PGameEvent(Event.user.data1)^.data)^.timerid));
                                                                            end else ProcessGameEvent(PGameEvent(event.user.data1));
event_InputAction:ProcessInputActionEvent(PInputAction(event.user.data1), event.user.code);
end;
end;

procedure TBasicObject.RegisterInputActions;
var PWalk:PList;
n:PInputActionMapNode;
begin
PWalk:=InputActionMap;
while PWalk<>nil do begin
                      n:=PWalk^.Data;
input^.RegisterInputActionStr(PChar(n^.sym), n^.action, self, pointer(n^.data));
PWalk:=PWalk^.Next;
end;
end;

procedure TBasicObject.RemoveInputAction(action: integer);
var PWalk:PList;
begin
                PWalk:=InputActionMap;
                while PWalk <> nil do begin
if PInputActionMapNode(PWalk^.Data)^.action = action then begin
FreeParameterReference(PInputActionMapNode(PWalk^.Data)^.data);
dispose(PInputActionMapNode(PWalk^.Data));
                list_removenode(InputActionMap, PWalk);
                break;
                end;
                PWalk := PWalk^.Next;
                end;
end;

procedure TBasicObject.RemoveTimer(timer: pointer);
var PWalk:PList;
begin
                PWalk := FTimers;
                while PWalk <> nil do begin
if PObjTimerListNode(PWalk^.Data)^.TimerID = cardinal(timer) then begin
Core_RemoveTimer(PObjTimerListNode(PWalk^.Data)^.TimerID);
FreeParameterReference(PObjTimerListNode(PWalk^.Data)^.data);
                                                dispose(PObjTimerListNode(PWalk^.Data));
list_removenode(FTimers, PWalk);
break;
end;
                PWalk := PWalk^.Next;
                end;
end;

procedure TBasicObject.SetFlags(f: cardinal);
begin
FFlags :=f;
end;

procedure TBasicObject.UnregisterInputActions;
var PWalk:PList;
begin
                PWalk:=InputActionMap;
                while PWalk <> nil do begin
input^.UnregisterInputAction(PInputActionMapNode(PWalk^.Data)^.action, self);
                PWalk:=PWalk^.Next;
                end;
                end;

procedure GameObj_RequireNeededPlugins;
begin
input:= core_RequirePlugin(InputI.InputSystemGUID);
SoundSystem:=Core_RequirePlugin(SoundSystemI.SoundSystemGUID);
SoundGeometry:=Core_RequirePlugin(SoundSystemI.SoundGeometryGUID);
end;

{ TGenericObject }

constructor TGenericObject.create(ScriptRef:TScriptReference; flags:cardinal; const pos:TVector3F;
  const primitive: TGeometricalPrimitive; directocclusion:single=1; reverbocclusion:single=0);
begin
inherited create(ScriptRef, flags);
FPosition:=pos;
FGeometry:=primitive;
CalculateBoxMinMax(FGeometry);
if flags and GF_HasSoundGeometry = GF_HasSoundGeometry then begin
case FGeometry._type of
GP_AABB, GP_OBB: FSoundGeometry := SoundGeometry^.CreateGeometryBox(FPosition, FGeometry.size, directocclusion, reverbocclusion);
GP_Sphere: FSoundGeometry := SoundGeometry^.CreateGeometryBox(FPosition, AffineVectorMake(FGeometry.radius, FGeometry.radius, FGeometry.radius), directocclusion, reverbocclusion);
end;
SoundGeometry^.SetGeometryRotation(FSoundGeometry, FGeometry.orientation[2], FGeometry.orientation[1]);
end;
end;

function TGenericObject.Move(v: TVector3F;
  IgnoreSolid: boolean): boolean;
  var
OldPos,pos,mov:TVector3F;
  begin
result:=True;
mov:=v;
while VectorNorm(mov) > 0 do begin
OldPos:=FPosition;
if VectorNorm(mov) > sqr(CollisionThreshold) then
pos :=VectorScale(VectorNormalize(v), CollisionThreshold)
else
pos :=mov;
SubtractVector(mov, pos);
position := vectorAdd(Position, pos);
if not ProcessNewPos then
if not IgnoreSolid then begin
                                              result:=false;
Position:=oldpos;
exit;
end;
end;
end;

procedure TGenericObject.Pitch(angle: single);
begin
case FGeometry._type of
GP_AABB, GP_OBB:
with FGeometry do
orientation := MatrixMultiply(orientation, CreateAffineRotationMatrix(AffineVectorMake(orientation[0,0],
orientation[0,1], orientation[0,2]), degtorad(angle)));
    GP_Sphere: ;
else log_write('TGenericObject.Pitch: warning: trying to rotate object without orientation matrix', ll_warn);
end;
ProcessRotation;
end;

procedure TGenericObject.ProcessCollision(victim: TGenericObject);
begin
ProcessCollisionEvent(self, victim);
end;

procedure TGenericObject.ProcessRotation;
var PWalk,PNext:PList;
begin
CalculateBoxMinMax(FGeometry);
if FFlags and GF_HasSoundGeometry = GF_HasSoundGeometry then
SoundGeometry^.SetGeometryRotation(FSoundGeometry, FGeometry.orientation[2], FGeometry.orientation[1]);
                      PWalk:=FSounds;
                      while PWalk <> nil do begin
                      PNext := PWalk^.Next;
if soundSystem^.GetSoundState(PObjSoundListNode(PWalk^.data)^.handle) <> ss_none then begin
SoundSystem^.SetSoundPos(PObjSoundListNode(PWalk^.Data)^.handle, VectorTransform(VectorAdd(FPosition,
PObjSoundListNode(PWalk^.Data)^.pos), FGeometry.orientation), false);
end else //sound is not valid, so remove it from the list
DetachSoundHandle(PObjSoundListNode(PWalk^.Data)^.handle);
                      PWalk := PNext;
                      end;
if FFlags and GF_ListenerAttached = GF_ListenerAttached then
SoundSystem^.SetListenerOrientation(FGeometry.orientation[2], FGeometry.orientation[1]);
                      end;

procedure TGenericObject.Roll(angle: single);
begin
case FGeometry._type of
GP_AABB, GP_OBB:
with FGeometry do
orientation := MatrixMultiply(orientation, CreateAffineRotationMatrix(AffineVectorMake(orientation[2,0],
orientation[2,1], orientation[2,2]), degtorad(angle)));
GP_Sphere: ;
else log_write('TGenericObject.Roll: warning: trying to rotate object without orientation matrix', ll_warn);
end;
ProcessRotation;
end;

function TGenericObject.ProcessNewPos:boolean;
var overlap, PWalk:PList;
collided:boolean;
begin
overlap:=nil;
collided:=false;
result:=true;
World_CheckObjectsCollision(self, overlap);
PWalk:=Overlap;
while PWalk <> nil do begin
collided:=true;
if FLastCollided <> PWalk^.Data then
                                ProcessCollision(TGenericObject(PWalk^.Data));
if                                 TGenericObject(PWalk^.Data).FLastCollided <> self then
                                TGenericObject(PWalk^.Data).ProcessCollision(self);
if TGenericObject(PWalk^.Data).flags and GF_Solid = GF_solid then result:=false;
FLastCollided := PWalk^.data;
                                TGenericObject(PWalk^.Data).FLastCollided := self;
                                PWalk:=PWalk^.Next;
end;
if not collided then FLastCollided := nil;
list_clear(overlap);
end;

procedure TGenericObject.SetPosition(pos: TVector3F);
begin
MoveSounds(VectorSubtract(pos, FPosition));
FPosition:=pos;
ProcessNewPos;
if FFlags and GF_HasSoundGeometry = GF_HasSoundGeometry then
SoundGeometry^.SetGeometryPos(FSoundGeometry, pos);
end;

procedure TGenericObject.Yaw(angle: single);
begin
case FGeometry._type of
gp_aabb, GP_OBB:
with FGeometry do
orientation := MatrixMultiply(orientation, CreateAffineRotationMatrix(AffineVectorMake(orientation[1,0],
orientation[1,1], orientation[1,2]), degtorad(angle)));
GP_Sphere: ;
else log_write('TGenericObject.Yaw: warning: trying to rotate object without orientation matrix', ll_warn);
end;
ProcessRotation;
end;

procedure TGenericObject.AttachSoundHandle(handle: SoundHandle);
var l:PObjSoundListNode;
begin
if SoundSystem^.GetSoundState(handle) <> ss_none then begin
new(l);
l^.handle := handle;
l^.pos := SoundSystem^.GetSoundPos(handle);
List_Add(FSounds, l);
end else //sound is not valid
log_write('TGenericObject.AttachSoundHandle: warning: passed handle is not a valid handle.', ll_warn);
                end;

procedure TGenericObject.DetachSoundHandle(Handle: SoundHandle);
var PWalk:PList;
begin
PWalk := FSounds;
while PWalk <> nil do begin
if PObjSoundListNode(PWalk^.Data)^.handle = handle then begin
dispose(PObjSoundListNode(PWalk^.Data));
List_Removenode(FSounds, PWalk);
break;
end;
PWalk:=PWalk^.Next;
end;
end;

function TGenericObject.Play3DSound(const res: PChar; pos: TVector3F;
  HeadRelative: boolean): SoundHandle;
begin
if not headRelative then result:=SoundSystem^.PlaySound3D(res, VectorAdd(FPosition,
VectorTransform(pos, FGeometry.orientation)), false) else begin
Result:=SoundSystem^.PlaySound3D(res, pos, true);
soundSystem^.SetSoundPos(result, SoundSystem^.getSoundPos(result), true);
SoundSystem^.PauseSound(result, false);
end;
AttachSoundHandle(result);
                          end;

function TGenericObject.Play3DSoundOnce(const handle: SoundHandle;
  res: PChar; pos: TVector3F; headrelative: boolean): SoundHandle;
begin
if not headRelative then result:=SoundSystem^.PlaySound3DOnce(handle, res, VectorAdd(FPosition,
VectorTransform(pos, FGeometry.orientation))) else begin
Result:=SoundSystem^.PlaySound3DOnce(handle, res, pos);
soundSystem^.SetSoundPos(result, SoundSystem^.getSoundPos(result), true);
SoundSystem^.PauseSound(result, false);
end;
AttachSoundHandle(result);
end;

procedure TGenericObject.SetListener(pos: TVector3F);
begin
SoundSystem^.SetListenerPos(VectorAdd(FPosition, VectorTransform(pos, FGeometry.orientation)));
end;

procedure TGenericObject.SetSoundsVelocity(v: TVector3F);
var PWalk,PNext:PList;
begin
PWalk:=FSounds;
                while PWalk <> nil do begin
                PNext:=PWalk^.Next;
if soundSystem^.GetSoundState(PObjSoundListNode(PWalk^.Data)^.handle) <> ss_none then
                SoundSystem^.SetSoundVelocity(PObjSoundListNode(PWalk^.Data)^.handle, v)
                else list_removenode(FSounds, PWalk);
PWalk := PNext;
                end;
if FFlags and GF_ListenerAttached = GF_ListenerAttached then
SoundSystem^.SetListenerVelocity(v);
                end;

procedure TGenericObject.moveSounds(const v: TVector3F);
var PWalk,PNext:PList;
begin
if vectornorm(v) = 0 then exit;
if FFlags and GF_ListenerAttached = GF_ListenerAttached then
SoundSystem^.MoveListener(v);
PWalk:=FSounds;
while PWalk <> nil do begin
PNext:=PWalk^.Next;
if SoundSystem^.GetSoundState(PObjSoundListNode(PWalk^.Data)^.handle) <> ss_none then
SoundSystem^.MoveSound(PObjSoundListNode(PWalk^.Data)^.handle, v)
else //sound is not valid, so remove it from the list
DetachSoundHandle(PObjSoundListNode(PWalk^.Data)^.handle);
PWalk:=PNext;
end;
end;

function TGenericObject.GetObjectUnderThis: TGenericObject;
var list,PWalk:PList;
oldPos:TVector3F;
begin
               list:=nil;
OldPos := self.FPosition;
result:=nil;
FPosition := AffineVectorMake(FPosition[0], FPosition[1] - CollisionThreshold, FPosition[2]);
world_CheckObjectsCollision(self, list);
FPosition := OldPos;
PWalk := List;
while PWalk <> nil do begin
if TGenericObject(PWalk^.Data).fposition[1] < FPosition[1] then result := PWalk^.data;
                     PWalk := PWalk^.Next;
end;
if list_size(list) > 1 then
//log_writeF('TGenericObject.GetObjectUnderThis: warning: there are more than one objects under this (pos: %g, %g, %g).', ll_warn, [FPosition[0], FPosition[1], FPosition[2]]);
        list_clear(list);
        end;

{ TDynamicObject }

function TDynamicObject.CalculateVelocity: TVector3F;
begin
result := VectorAdd(FVelocity, VectorTransform(FRelativeVelocity, FGeometry.orientation));
end;

constructor TDynamicObject.create(ScriptRef: TScriptReference;
  flags: cardinal; const pos: TVector3F;
  const primitive: TGeometricalPrimitive; directocclusion,
  reverbocclusion: single);
begin
Inherited;
end;

procedure TDynamicObject.ProcessEvent(event: tsdl_event);
begin
///
case PGameEvent(event.user.data1)^.code  of
WORLDEVENT_ENDFREEFALL: begin
processEndFreeFallEvent(self, single(PGameEvent(event.user.data1)^.data^));
freemem(PGameEvent(event.user.data1)^.data);
end;
    else  inherited;
end;
end;

procedure TDynamicObject.SetRelativeVelocity(v: TVector3F);
begin
FRelativeVelocity := v;
SetSoundsVelocity(CalculateVelocity());
end;

procedure TDynamicObject.SetVelocity(v: TVector3F);
begin
                                       FVelocity := v;
                                       SetSoundsVelocity(CalculateVelocity());
end;

procedure TDynamicObject.update(TimeElapsed:single);
var obj:TGenericObject;
A:TVector3F;
FF:^single;
begin
if (FFlags and GF_AffectGravity) = GF_AffectGravity then begin
obj := GetObjectUnderThis;
if (obj = nil) or (obj.flags and GF_Solid <> gf_Solid) then begin
if not FFreeFalling then begin
                                                                 FFreeFalling := true;
World_PushGameEvent(self, WORLDEVENT_STARTFREEFALL, nil);
                                                                 end;
                                                                 A := AffineVectorMake(0,-9.81,0);
end else begin
if VectorNorm(FVelocity) = 0 then
a := NullVector
else A := AffineVectorMake(0,-9.81,0);
if FFreeFalling then begin
new(ff);
ff^ := self.FVelocity[1] / 9.81;
world_PushGameEvent(self, WORLDEVENT_ENDFREEFALL, ff);
FFreeFalling := false;
end;
end;
end;
a := VectorAdd(FAccel, A);
if VectorNorm(A) > 0 then
Velocity := VectorAdd(FVelocity, VectorScale(A, TimeElapsed));
if VectorNorm(FRelativeAccel) > 0 then
RelativeVelocity := VectorAdd(FRelativeVelocity, VectorScale(FRelativeAccel, TimeElapsed));
if not Move(VectorScale(CalculateVelocity, TimeElapsed)) then begin
velocity :=NullVector;
RelativeVelocity := NullVector;
end;
end;

end.
